home *** CD-ROM | disk | FTP | other *** search
/ Amiga CD-ROM Collection / Amiga CD-ROM Collection - Auge 4000 and Cactus and Demo Util.iso / cactus / 33 / progs / demos / gadgets.gfa (.txt) < prev    next >
GFA-BASIC Atari  |  1989-06-25  |  8KB  |  355 lines
  1. ' Gadgetstrukturen in GFA-Basic erzeugen
  2. '
  3. ' Thomas Ströter
  4. ' 20.4.89 / 14:00h
  5. '
  6. gg_max&=20                              ! maximal 20 Gadgets
  7. DIM gg_ad%(gg_max&),gg_dx#(gg_max&),gg_dy#(gg_max&)
  8. '
  9. demo
  10. > PROCEDURE readme
  11.   ' Gadgets in GFA-Basic!
  12.   '
  13.   '   Ablauf:
  14.   '   Gadget initialisieren
  15.   '   Fenster oder Screen öffnen
  16.   '   mit addgadget Gadget anzeigen
  17.   '   Fenster schließen
  18.   '   Gadgetspeicher zurückgeben (free_gadget)
  19.   '
  20.   '
  21.   '   booltextgadget(X,Y,Breite,Höhe,String,GADG_ID) keine Initialisierung
  22.   '
  23.   '   init_propgadget(GADG_ID)
  24.   '   size_propgadget(GADG_ID,X,Y,Breite,Höhe,x-steps,y-steps)
  25.   '
  26.   '   init_stringgadget(GADG)
  27.   '   size_stringgadget(GADG_ID,X,Y,Breite,Länge,String)
  28.   '   make_ival(GADG_ID)          macht aus einem String- ein IntegerGadget
  29.   '   get_ival(GADG_ID,Integer%)  liest den Integerwert aus
  30.   '   get_string(GADG_ID,String)  liest Stringwert aus
  31.   '   text_gadget(GADG_ID,x_off,y_off,String,Farbe)
  32.   '   border_gadget(x1_of,y1_off,x2_off,y2_of,GADG_ID)
  33.   '
  34.   ' wichtig:
  35.   ' Im geöffneten Fenster müssen die IDCMP-Flags für
  36.   '   Gadget gedrückt     (&H20)
  37.   '   GADGET losgelassen  (&H40)
  38.   ' gesetzt sein.
  39.   ' Geben Sie niemals ein Gadget frei, solange das dazugehörende
  40.   ' Fenster noch geöffnet ist !
  41.   '
  42. RETURN
  43. > PROCEDURE demo
  44.   init_propgadget(i&)
  45.   size_propgadget(i&,150,30,200,10,31400,0)
  46.   text_gadget(i&,10,20,"Testme",3)
  47.   text_gadget(i&,0,-11,"Schiebe Gadget",1)
  48.   init_propgadget(j&)
  49.   size_propgadget(j&,250,50,100,50,16,8)
  50.   '
  51.   booltextgadget(150,80,44,10,"Test",h&)
  52.   border_gadget(1,-1,44,11,3,h&)
  53.   border_gadget(2,0,44,11,1,h&)
  54.   '
  55.   init_stringgadget(s&)
  56.   init_stringgadget(t&)
  57.   make_ivalgadget(s&)
  58.   '
  59.   size_stringadget(s&,20,90,10,20,"Click on me")
  60.   border_gadget(-1,-1,10*8,8,1,s&)
  61.   text_gadget(s&,-1,-11,"TextGadget",2)
  62.   text_gadget(s&,1,-10,"TextGadget",1)
  63.   text_gadget(s&,1,10,"Beliebig Beschriftbar !",3)
  64.   '
  65.   size_stringadget(t&,20,110,50,100,"String100")
  66.   border_gadget(-1,-1,50*8,8,1,t&)
  67.   '
  68.   WORD{0,0,0,640,200,&H668,&H1100F
  69.   w%=ADDRIN0)
  70.   addgadget(w%,i&)
  71.   addgadget(w%,h&)
  72.   addgadget(w%,s&)
  73.   addgadget(w%,j&)
  74.   addgadget(w%,t&)
  75.   ~gg_ad%(s&),ADDRIN0),0)
  76.   '  ~RefreshGadgets(gg_ad%(i&),WINDOW(0),0)
  77.   '
  78.   ende!=TRUE
  79.   ON MENU MESSAGE GOSUB whatgadget
  80.   REPEAT
  81.     RBOX 
  82.   UNTIL ende!=FALSE
  83.   get_string(s&,m$)
  84.   get_ival(s&,kl%)
  85.   CLOSEW 0
  86.   '
  87.   FOR a&=0 TO gg_max&
  88.     free_gadget(i&)
  89.   NEXT a&
  90. RETURN
  91. > PROCEDURE whatgadget
  92.   LOCAL ad%,x&,y&
  93.   SELECT MENU(1)
  94.     '                                   - Gadget gedrückt
  95.   CASE 32
  96.     '                                   - Gadgets loslassen
  97.   CASE 64
  98.     ad%=MENU(4)
  99.     gg_id&=CARD{ADD(ad%,38)}
  100.     PRINT AT(10,15);"Gadget:";gg_id&;"  "
  101.     SELECT CARD{ADD(ad%,16)}
  102.       '                                  ** Boolean Gadget
  103.     CASE 1
  104.       '                                  ** Proportional Gadget
  105.     CASE 3
  106.       x&=CINT(CARD{ADD(ad%,46)}/gg_dx#(gg_id&))
  107.       y&=CINT(CARD{ADD(ad%,48)}/gg_dy#(gg_id&))
  108.       PRINT AT(10,17);"x    :";x&;"  "
  109.       PRINT AT(10,18);"y    :";y&;"  "
  110.     CASE 4
  111.       '                                  ** String/Integer Gadget
  112.     ENDSELECT
  113.     '                                    - Close Gadget
  114.   CASE 512
  115.     ende!=FALSE
  116.   ENDSELECT
  117. RETURN
  118. '
  119. > PROCEDURE init_propgadget(VAR pg_id&)
  120.   LOCAL ad%
  121.   pg_id&=-1
  122.   REPEAT
  123.     INC pg_id&
  124.   UNTIL pg_id&=gg_max& OR gg_ad%(pg_id&)=0
  125.   IF pg_id&=gg_max&
  126.     ALERT 0,"Alle Gadgetspeicher belegt ("+STR$(gg_max&)+")",1,"OK",a|
  127.     pg_id&=0
  128.   ELSE
  129.     gg_ad%(pg_id&)=MALLOC(74,&H10003)
  130.     ad%=gg_ad%(pg_id&)
  131.     CARD{ADD(ad%,12)}=3
  132.     CARD{ADD(ad%,14)}=3
  133.     CARD{ADD(ad%,16)}=3
  134.     LONG{ADD(ad%,18)}=ad%+66
  135.     LONG{ADD(ad%,34)}=ad%+44
  136.     CARD{ADD(ad%,38)}=pg_id&
  137.     CARD{ADD(ad%,44)}=1              ! Autoknob
  138.   ENDIF
  139. RETURN
  140. > PROCEDURE size_propgadget(pg_id&,x&,y&,w&,h&,xstep&,ystep&)
  141.   ad%=gg_ad%(pg_id&)
  142.   IF ad%<>0
  143.     ADD(ad%,4)}=x&
  144.     ADD(ad%,6)}=y&
  145.     ADD(ad%,8)}=w&
  146.     ADD(ad%,10)}=h&
  147.     CARD{ADD(ad%,44)}=1
  148.     IF xstep&<>0
  149.       CARD{ADD(ad%,50)}=DIV(&HFFFF,xstep&)
  150.       CARD{ADD(ad%,44)}=CARD{ADD(ad%,44)} OR 2
  151.       gg_dx#(pg_id&)=&HFFFF/xstep&
  152.     ELSE
  153.       CARD{ADD(ad%,50)}=&HFFFF
  154.       gg_dx#(pg_id&)=&HFFFF
  155.     ENDIF
  156.     IF ystep&<>0
  157.       CARD{ADD(ad%,52)}=DIV(&HFFFF,ystep&)
  158.       CARD{ADD(ad%,44)}=CARD{ADD(ad%,44)} OR 4
  159.       gg_dy#(pg_id&)=&HFFFF/ystep&
  160.     ELSE
  161.       CARD{ADD(ad%,52)}=&HFFFF
  162.       gg_dy#(pg_id&)=&HFFFF
  163.     ENDIF
  164.   ENDIF
  165. RETURN
  166. > PROCEDURE free_gadget(gg_id&)
  167.   LOCAL ad%,a%,b%
  168.   ad%=gg_ad%(gg_id&)
  169.   IF ad%<>0
  170.     '                                   ! Textzurück
  171.     a%={ADD(ad%,26)}
  172.     IF a%<>0
  173.       WHILE a%<>0
  174.         b%={ADD(a%,16)}
  175.         ~MFREE(a%,CARD{ADD(a%,20)})
  176.         a%=b%
  177.       WEND
  178.     ENDIF
  179.     '                                   ! Border zurück
  180.     a%={ADD(ad%,18)}
  181.     IF AND(CARD{ADD(ad%,16)},7)=1 AND AND(CARD{ADD(ad%,12)},4)=0
  182.       IF a%<>0
  183.         WHILE a%<>0
  184.           b%={ADD(a%,12)}
  185.           ~MFREE(a%,36)
  186.           a%=b%
  187.         WEND
  188.       ENDIF
  189.     ENDIF
  190.     '                                   ! GadgetStruct zurück
  191.     IF {ADD(ad%,16)}=4
  192.       ~MFREE(ad%,592)                   ! String/Integer Gadget
  193.     ELSE
  194.       ~MFREE(ad%,74)
  195.     ENDIF
  196.     gg_ad%(gg_id&)=0
  197.   ENDIF
  198.   '
  199. RETURN
  200. > PROCEDURE booltextgadget(x&,y&,w&,h&,a$,VAR pg_id&)
  201.   pg_id&=-1
  202.   REPEAT
  203.     INC pg_id&
  204.   UNTIL pg_id&=gg_max& OR gg_ad%(pg_id&)=0
  205.   IF pg_id&=gg_max&
  206.     ALERT 0,"Alle Gadgetspeicher belegt ("+STR$(gg_max&)+")",1,"OK",a|
  207.     pg_id&=0
  208.   ELSE
  209.     w&=MAX(w&,LEN(a$)*8)
  210.     h&=MAX(h&,8)
  211.     gg_ad%(pg_id&)=MALLOC(74,&H10003)
  212.     ad%=gg_ad%(pg_id&)
  213.     CARD{ad%+4}=x&
  214.     CARD{ad%+6}=y&
  215.     CARD{ad%+8}=w&
  216.     CARD{ad%+10}=h&
  217.     CARD{ad%+12}=1
  218.     CARD{ad%+14}=&H103
  219.     CARD{ad%+16}=1
  220.     CARD{ad%+38}=pg_id&
  221.     text_gadget(pg_id&,(w&-LEN(a$)*8)/2,(h&-8)/2,a$,1)
  222.   ENDIF
  223. RETURN
  224. > PROCEDURE text_gadget(gg_id&,x&,y&,a$,c1|)
  225.   ad%=gg_ad%(gg_id&)
  226.   IF ad%<>0
  227.     a$=a$+CHR$(0)
  228.     ad%=ad%+26
  229.     IF {ad%}<>0
  230.       REPEAT
  231.         ad%={ad%}+16
  232.       UNTIL {ad%}=0
  233.     ENDIF
  234.     gt%=MALLOC(22+LEN(a$),&H10003)
  235.     LONG{ad%}=gt%
  236.     BYTE{gt%}=c1|
  237.     BYTE{gt%+2}=0
  238.     gt%+4}=x&
  239.     gt%+6}=y&
  240.     LONG{gt%+12}=gt%+22
  241.     CARD{gt%+20}=LEN(a$)+22
  242.     BMOVE V:a$,gt%+22,LEN(a$)
  243.   ENDIF
  244. RETURN
  245. > PROCEDURE addgadget(w%,gg_id&)
  246.   IF gg_ad%(gg_id&)<>0
  247.     ~w%,gg_ad%(gg_id&),99)
  248.     ~gg_ad%(gg_id&),w%,0)
  249.   ENDIF
  250. RETURN
  251. > PROCEDURE border_gadget(x1&,y1&,x2&,y2&,c|,gg_id&)
  252.   LOCAL ad%,a%
  253.   ad%=gg_ad%(gg_id&)
  254.   IF ad%<>0
  255.     ad%=ad%+18
  256.     IF {ad%}<>0
  257.       REPEAT
  258.         ad%={ad%}+12
  259.       UNTIL {ad%}=0
  260.     ENDIF
  261.     a%=MALLOC(36,&H10003)
  262.     LONG{ad%}=a%
  263.     '    BYTE{add(a%,5)}=c|
  264.     BYTE{ADD(a%,4)}=c|
  265.     BYTE{ADD(a%,7)}=5
  266.     {ADD(a%,8)}=ADD(a%,16)
  267.     CARD{ADD(a%,16)}=x1&     ! Border Struktur
  268.     CARD{ADD(a%,18)}=y1&
  269.     CARD{ADD(a%,20)}=x2&
  270.     CARD{ADD(a%,22)}=y1&
  271.     CARD{ADD(a%,24)}=x2&
  272.     CARD{ADD(a%,26)}=y2&
  273.     CARD{ADD(a%,28)}=x1&
  274.     CARD{ADD(a%,30)}=y2&
  275.     CARD{ADD(a%,32)}=x1&
  276.     CARD{ADD(a%,34)}=y1&
  277.   ENDIF
  278. RETURN
  279. > PROCEDURE init_stringgadget(VAR sg_id&)
  280.   LOCAL ad%
  281.   sg_id&=-1
  282.   REPEAT
  283.     INC sg_id&
  284.   UNTIL sg_id&=gg_max& OR gg_ad%(sg_id&)=0
  285.   IF sg_id&=gg_max&
  286.     ALERT 0,"Alle Gadgetspeicher belegt ("+STR$(gg_max&)+")",1,"OK",a|
  287.     sg_id&=0
  288.   ELSE
  289.     gg_ad%(sg_id&)=MALLOC(592,&H10003)
  290.     ad%=gg_ad%(sg_id&)
  291.     CARD{ADD(ad%,14)}=3      ! Avtivation
  292.     CARD{ADD(ad%,16)}=4      ! Type
  293.     LONG{ADD(ad%,34)}=ADD(ad%,44) ! Special Info
  294.     CARD{ADD(ad%,38)}=sg_id& ! ID
  295.     '
  296.     ad%=ADD(ad%,44)          ! Strig-Info
  297.     {ad%}=ADD(ad%,36)
  298.     {ADD(ad%,4)}=ADD(ad%,36+256)
  299.     CARD{ADD(ad%,10)}=255
  300.   ENDIF
  301. RETURN
  302. > PROCEDURE size_stringadget(sg_id&,x&,y&,wscroll&,len&,a$)
  303.   LOCAL ad%
  304.   ad%=gg_ad%(sg_id&)
  305.   IF ad%<>0
  306.     IF CARD{ADD(ad%,16)}=4
  307.       len&=MIN(len&,255)
  308.       wscroll&=MIN(wscroll&,len&)
  309.       CARD{ADD(ad%,4)}=x&
  310.       CARD{ADD(ad%,6)}=y&
  311.       CARD{ADD(ad%,8)}=wscroll&*8
  312.       CARD{ADD(ad%,10)}=10
  313.       ad%=ADD(ad%,44)
  314.       CARD{ADD(ad%,10)}=ADD(len&,1)
  315.       IF a$<>""
  316.         CARD{ADD(ad%,16)}=LEN(a$)
  317.         BMOVE V:a$,{ad%},CARD{ADD(ad%,16)}
  318.       ENDIF
  319.     ENDIF
  320.   ENDIF
  321. RETURN
  322. > PROCEDURE get_string(sg_id&,VAR a$)
  323.   LOCAL ad%,len&
  324.   ad%=gg_ad%(sg_id&)
  325.   IF ad%<>0
  326.     IF CARD{ad%+16}=4
  327.       ad%=ADD(ad%,44)             ! Zeiger Strinfo
  328.       len&=CARD{ADD(ad%,16)}
  329.       IF len&<>0
  330.         a$=STRING$(len&,32)
  331.         BMOVE {ad%},V:a$,len&
  332.       ENDIF
  333.     ENDIF
  334.   ELSE
  335.     a$=""
  336.   ENDIF
  337. RETURN
  338. > PROCEDURE make_ivalgadget(sg_id&)
  339.   LOCAL ad%,len&
  340.   ad%=gg_ad%(sg_id&)
  341.   IF ad%<>0
  342.     IF CARD{ad%+16}=4
  343.       CARD{ad%+14}=OR(CARD{ad%+14},&H800)
  344.     ENDIF
  345.   ENDIF
  346. RETURN
  347. > PROCEDURE get_ival(sg_id&,VAR integer%)
  348.   ad%=gg_ad%(sg_id&)
  349.   IF ad%<>0
  350.     IF AND(CARD{ad%+14},&H800)=&H800 AND CARD{ad%+16}=4
  351.       integer%={ad%+44+28}
  352.     ENDIF
  353.   ENDIF
  354. RETURN
  355.